home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Src / streams.c < prev    next >
C/C++ Source or Header  |  1993-07-16  |  17KB  |  774 lines
  1. /* 
  2.   * nprint.c
  3.   * Revised printing routines for feel
  4.   * Idea is that a stream should only handle 
  5.   * its raw type (eg strings, or bytesequences)
  6.   */
  7.  
  8. #include <stdio.h>
  9. #include <ctype.h>
  10.  
  11. #ifndef SEEK_SET /* For non-conforming defs of seek */
  12. #define SEEK_SET 0
  13. #endif 
  14.  
  15. #include "funcalls.h"
  16. #include "defs.h"
  17. #include "structs.h"
  18. #include "error.h"
  19. #include "global.h"
  20. #include "allocate.h"
  21. #include "modboot.h"
  22. #include "calls.h"
  23.  
  24. #include "streams.h"
  25. #include "reader.h"
  26. #include "ngenerics.h"
  27.  
  28. #if 0 /* debugging ..*/
  29. (fprintf(stderr, "File: %x",*((FILE **) stringof(fobj))))
  30. #endif
  31.  
  32. #define fpof(fobj)   (*((FILE **) stringof(fobj)))
  33.  
  34. #define fpof1(fobj)   (*((FILE **) stringof(fobj)))
  35.  
  36. /* Standard Streams */
  37.  
  38. LispObject std_streams;
  39.  
  40. EUFUN_0(Fn_std_streams)
  41. {
  42.   return std_streams;
  43. }
  44. EUFUN_CLOSE
  45.  
  46. /* File operations */
  47.  
  48. static EUFUN_2(Fn_fopen,name,mode)
  49. { 
  50.   LispObject ans;
  51.   FILE *fp;
  52.   
  53.   fp=fopen(stringof(name),stringof(mode));
  54.   if (fp==NULL)
  55.     CallError(stacktop,"Could not open file",name,NONCONTINUABLE);
  56.   ans=allocate_string(stacktop,"",sizeof(FILE*));
  57.   fpof1(ans)=fp;
  58.   return ans;
  59. }
  60. EUFUN_CLOSE 
  61.  
  62. static EUFUN_2(Fn_popen,name,mode)
  63. {
  64. #ifdef HAS_POPEN
  65.   LispObject ans;
  66.   FILE *fp;
  67.   
  68.   fp=popen(stringof(name),stringof(mode));
  69.   if (fp==NULL)
  70.     CallError(stacktop,"Could not open pipe",name,NONCONTINUABLE);
  71.   ans=allocate_string(stacktop,"",sizeof(FILE*));
  72.   fpof1(ans)=fp;
  73.   return ans;
  74. #else
  75.   CallError(stacktop,"popen: no pipes here",nil,NONCONTINUABLE);
  76.   return nil;
  77. #endif
  78. }
  79. EUFUN_CLOSE
  80.   
  81. static EUFUN_1(Fn_reopen,what)
  82. {
  83.   LispObject ans;
  84.   FILE *fp;
  85.  
  86.   switch (intval(what))
  87.     {
  88.     case 0:
  89.       fp=stdin;
  90.       break;
  91.     case 1:
  92.       fp=stdout;
  93.       break;
  94.     case 2:
  95.       fp=stderr;
  96.       break;
  97.     default:
  98.       return nil;
  99.     }
  100.  
  101.   ans=allocate_string(stacktop,"",sizeof(FILE*));
  102.   fpof1(ans)=fp;
  103.   
  104.   return ans;
  105. }
  106. EUFUN_CLOSE
  107.  
  108. static EUFUN_2(Fn_seek,stream,offset)
  109. {
  110.   int ret;
  111.   
  112.   if (!is_fixnum(offset))
  113.     CallError(stacktop,"seek[file]: Invalid offset",offset,NONCONTINUABLE);
  114.  
  115.   ret=fseek(fpof(stream),intval(offset),SEEK_SET);
  116.   
  117.   if (ret)
  118.     CallError(stacktop,"seek[file]: Seek failed",offset,NONCONTINUABLE);
  119.   
  120. #ifdef WITH_FUDGE
  121.   {
  122.     extern void yy_reset_stream(FILE *);
  123.     yy_reset_stream(fpof(stream));            
  124.   }
  125. #endif
  126.  
  127.   return lisptrue;
  128. }
  129. EUFUN_CLOSE
  130.   
  131. static EUFUN_1(Fn_tell,stream)
  132. {
  133.   int ret;
  134.  
  135.   ret=ftell(fpof(stream));
  136.   
  137.   if (ret<0)
  138.     CallError(stacktop,"tell[file]: Tell failed",stream,NONCONTINUABLE);
  139.  
  140.   return(allocate_integer(stacktop,ret));
  141. }
  142. EUFUN_CLOSE
  143.   
  144. static EUFUN_1(Fn_flush,stream)
  145. {
  146.   int ret;
  147.  
  148.   ret=fflush(fpof(stream));
  149.   if (ret!=0)
  150.     {    
  151. #if 0 /* Stardents sometimes return non-zero on flush! */
  152.       print_string(stacktop,StdOut(),"Ouch--flush failure\n");
  153.       EUCALL_3(generic_apply_2,generic_prin,stream,StdOut());
  154. #endif
  155.       return nil;
  156.  
  157.     }    
  158. /*CallError(stacktop,"flush[file]: flush failed",stream,NONCONTINUABLE);*/
  159.   
  160.   return lisptrue;
  161. }
  162. EUFUN_CLOSE
  163.   
  164. /* Bug: Pipes should call pclose, not fclose! */
  165.  
  166. static EUFUN_1(Fn_close,stream)
  167. { 
  168.   int ret;
  169.   
  170.   ret=reader_fclose(stacktop,fpof(stream));
  171.   if (ret!=0)    
  172.     {
  173.       perror("close");
  174.       CallError(stacktop,"close[file]: close failed",stream,NONCONTINUABLE);
  175.     }
  176.   
  177.   return lisptrue;
  178. }
  179. EUFUN_CLOSE
  180.   
  181. /* Output to a stream */
  182.  
  183. /* This can handle both strings and characters */
  184.   
  185. static EUFUN_2(Fn_put,stream,ob)
  186. {
  187.   if (is_string(ob))
  188.     {
  189.       fputs(stringof(ob),fpof(stream));
  190.       return ob;
  191.     }
  192.   
  193.   if (is_char(ob))
  194.     {
  195.       fputc(ob->CHAR.code,fpof(stream));
  196.       return ob;
  197.     }
  198.   
  199.   CallError(stacktop,"put[file]: Invalid object type",classof(ob),NONCONTINUABLE);
  200.   return nil; /* Not ever */
  201. }
  202. EUFUN_CLOSE
  203.  
  204.   
  205. static EUFUN_2(Fn_prin_fixnum,n,stream)
  206. {    
  207.   char buf[32];
  208.   
  209.   sprintf(buf,"%d",intval(n));
  210.   return(print_string(stacktop,stream,buf));
  211. }    
  212. EUFUN_CLOSE
  213.   
  214. /* Callbacks */
  215. LispObject generic_prin,generic_write, generic_flush;
  216. static LispObject generic_output,generic_read;
  217. LispObject format_specifiers;
  218. static LispObject Fn_prin_list(LispObject *);
  219.  
  220. EUFUN_2(Fn_print,ob,stream)
  221. {
  222.   if (stream==nil)
  223.     stream=StdOut();
  224.   else
  225.     stream=stream;
  226.   
  227.   STACK_TMP(stream);
  228.   generic_apply_2(stacktop,generic_prin,ob,stream);
  229.   UNSTACK_TMP(stream);
  230.   print_string(stacktop,stream,"\n");
  231.   
  232.   return ARG_0(stackbase);
  233. }
  234. EUFUN_CLOSE
  235. /* Ops coded in 'C' for efficiency */
  236. /* Only handles a few cases --- needed to bootstrap */
  237. static EUFUN_2(Fn_prin_object,ob,stream)
  238. {
  239.   switch(typeof(ob))
  240.     {
  241.     case TYPE_CONS:    
  242.       EUCALL_2(Fn_prin_list,ob,stream);
  243.       break;
  244.  
  245.     case TYPE_INT:
  246.       EUCALL_2(Fn_prin_fixnum,ob,stream);
  247.       break;
  248.  
  249.     case TYPE_STRING:
  250.       print_string(stacktop,stream,stringof(ob));
  251.       break;
  252.       
  253.     case TYPE_SYMBOL:
  254.       print_string(stacktop,stream,stringof(ob->SYMBOL.pname));
  255.       break;
  256.  
  257.     default:
  258.       {
  259.     char buf[32];
  260.     print_string(stacktop,stream,"#<");
  261.     print_string(stacktop,ARG_1(stackbase),stringof(classof(ARG_0(stackbase))->CLASS.name->SYMBOL.pname));
  262.     sprintf(buf,": %x>",(unsigned long) ob);
  263.     print_string(stacktop,ARG_1(stackbase),buf);
  264.       }
  265.       break;
  266.  
  267.     }    
  268.  
  269.   return ARG_0(stackbase);
  270. }
  271. EUFUN_CLOSE
  272.  
  273. static EUFUN_2(Fn_prin_list,form,stream)
  274. {
  275.   stacktop++;
  276.   ARG_2(stackbase)=form;
  277.   if (typeof(stream)==TYPE_STREAM)
  278.     {
  279.       putc('(',fpof(stream));
  280.       generic_apply_2(stacktop,generic_prin, CAR(form), ARG_1(stackbase));
  281.       form = ARG_0(stackbase);
  282.  
  283.       form=CDR(form);
  284.       while (is_cons(form))
  285.     {
  286.       putc(' ',fpof(ARG_1(stackbase)));
  287.       ARG_0(stackbase) = form;
  288.       generic_apply_2(stacktop,generic_prin, CAR(form), ARG_1(stackbase));
  289.       form = ARG_0(stackbase);
  290.       form=CDR(form);
  291.     }
  292.       if (form!=nil)
  293.     {
  294.       fputs(" . ",fpof(ARG_1(stackbase)));
  295.       generic_apply_2(stacktop,generic_prin, form, ARG_1(stackbase));
  296.     }
  297.       putc('(',fpof(ARG_1(stackbase)));
  298.     }
  299.   else
  300.     {
  301.       LispObject s; /* Temporary for holding bits of string */
  302.       
  303.       s=allocate_string(stacktop,"(",3);
  304.       STACK_TMP(s);
  305.       generic_apply_2(stacktop,generic_prin,s,ARG_1(stackbase));
  306.       form=ARG_0(stackbase);
  307.       generic_apply_2(stacktop,generic_prin,CAR(form),ARG_1(stackbase));
  308.       
  309.       UNSTACK_TMP(s);
  310.       strcpy(stringof(s)," ");
  311.       form=CDR(ARG_0(stackbase));
  312.       STACK_TMP(s);
  313.       while (is_cons(form))
  314.     {
  315.       UNSTACK_TMP(s);
  316.       STACK_TMP(s);
  317.       ARG_0(stackbase)=form;
  318.       generic_apply_2(stacktop,generic_prin,s,ARG_1(stackbase));      
  319.       form=ARG_0(stackbase);
  320.       generic_apply_2(stacktop,generic_prin,CAR(form),ARG_1(stackbase));
  321.       form=CDR(ARG_0(stackbase));
  322.     }
  323.       UNSTACK_TMP(s);
  324.       STACK_TMP(s);
  325.       if (form!=nil)
  326.     {
  327.       strcpy(stringof(s)," . ");
  328.       ARG_0(stackbase)=form;
  329.       generic_apply_2(stacktop,generic_prin,s,ARG_1(stackbase));
  330.       form=ARG_0(stackbase);
  331.       generic_apply_2(stacktop,generic_prin,form,ARG_1(stackbase));
  332.     }
  333.       UNSTACK_TMP(s);
  334.       strcpy(stringof(s),")");
  335.       generic_apply_2(stacktop,generic_prin,s,ARG_1(stackbase));
  336.     }
  337.   return ARG_0(stackbase);
  338. }    
  339. EUFUN_CLOSE
  340.  
  341. /* HACK: if stream is nil, use stdout. if t, use sederr */
  342. LispObject print_string(LispObject *stacktop,LispObject stream, char *ptr)
  343. {
  344.   if (typeof(stream)==TYPE_STREAM)
  345.     fputs(ptr,fpof(stream));
  346.   else if (stream==nil)
  347.     fputs(ptr,stdout);
  348.   else if (stream==lisptrue)
  349.     fputs(ptr,stderr);
  350.   else
  351.     {
  352.       LispObject s;
  353.       STACK_TMP(stream);
  354.       s=allocate_string(stacktop,ptr,strlen(ptr));
  355.       UNSTACK_TMP(stream);
  356.       generic_apply_2(stacktop,generic_prin,s,stream);
  357.     }
  358.   return nil;
  359. }
  360.  
  361. /* Format operations */
  362.  
  363. /* Getting at callbacks */
  364.  
  365. static EUFUN_0(Fn_std_formatters)
  366. {
  367.   return format_specifiers;
  368. }
  369. EUFUN_CLOSE
  370.  
  371. #define FORMATSIZE 200
  372. /* Internal format --- can't handle format nil, t, etc */
  373. static EUFUN_3(Fn_iformat,stream,fmt,args)
  374. {
  375.   char buf[FORMATSIZE];
  376.   char *next,*fmtptr,c;
  377.   int i,j,done=FALSE;
  378.   LispObject add_arg=nil;
  379.  
  380.   /* Check arguments */
  381.   
  382.   /* wait until we get a tilde */
  383.   
  384.   j=0;
  385.   
  386.   while (!done)
  387.     {
  388.       i=0;
  389.       while ( (c=stringof(fmt)[j])!='\0'
  390.          && c!='~')
  391.     {
  392.       buf[i++]=c;
  393.       j++;
  394.       if (i==FORMATSIZE-1)
  395.         {    
  396.           print_string(stacktop,stream,buf);
  397.           fmt=ARG_1(stackbase);
  398.           stream=ARG_0(stackbase);
  399.           i=0;
  400.         }
  401.     }
  402.   
  403.       buf[i]='\0';
  404.       if (i!=0)
  405.     print_string(stacktop,stream,buf);
  406.       fmt=ARG_1(stackbase);
  407.       /* We have to be careful here as fmt may move */
  408.  
  409.       if (c=='\0')
  410.     done=TRUE;
  411.       else
  412.     {
  413.       int n1,n2;
  414.       LispObject tmp=nil;
  415.  
  416.       j++;
  417.       fmtptr=&stringof(fmt)[j];
  418.       n1=strtol(fmtptr,&next,10);
  419.       if (next!=fmtptr)
  420.         {
  421.           if (*next=='.')
  422.         {
  423.           fmtptr=next+1;
  424.           n2=strtol(fmtptr,&next,10);
  425.           if (next==fmtptr)
  426.             CallError(stacktop,"format: No number after dot",fmt,NONCONTINUABLE);
  427.           
  428.           tmp=allocate_integer(stacktop,n2);
  429.         }
  430.           j=next-stringof(fmt);
  431.           add_arg=allocate_integer(stacktop,n1);
  432.           add_arg=EUCALL_2(Fn_cons,add_arg,tmp);
  433.         }
  434.       fmt=ARG_1(stackbase);
  435.       if (stringof(fmt)[j]=='\0')
  436.         done=TRUE;
  437.       else
  438.         {
  439.           LispObject fn;
  440.  
  441.           fn=vref(format_specifiers,stringof(fmt)[j]);
  442.           if (fn==nil)
  443.         CallError(stacktop,"Format: unknown format specifier",fmt,NONCONTINUABLE);
  444.       
  445.           args=EUCALL_4(apply3,fn,ARG_0(stackbase),ARG_2(stackbase),add_arg);
  446.           ARG_2(stackbase)=args;
  447.           j++;
  448.           fmt=ARG_1(stackbase);
  449.           stream=ARG_0(stackbase);
  450.         }
  451.     }
  452.     } /* end while(1) */
  453.   return nil;
  454. }
  455. EUFUN_CLOSE
  456.  
  457. /* Format functions */
  458. #ifndef N_BITS_IN_CHAR
  459. #define N_BITS_IN_CHAR 8
  460. #endif
  461.  
  462. #define BIGBIN sizeof(int)*N_BITS_IN_CHAR
  463. static EUFUN_3(Fn_format_b,stream,args,add_args)
  464. {
  465.   char buf[BIGBIN+1];
  466.   int n;
  467.   char *ptr;
  468.   
  469.   if (!is_fixnum(CAR(args)))
  470.     CallError(stacktop,"format: not an integer",CAR(args),NONCONTINUABLE);
  471.         
  472.   n=intval(CAR(args));
  473.   ptr=buf+BIGBIN;
  474.   buf[BIGBIN+1]=0;
  475.  
  476.   while(n!=0)
  477.     {
  478.       *ptr-- = (n&1)+'0';
  479.       n>>=1;
  480.     }
  481.         
  482.   print_string(stacktop,stream,ptr+1);
  483.   
  484.   return CDR(args);
  485. }
  486. EUFUN_CLOSE
  487.  
  488. static EUFUN_3(Fn_format_u,stream,args,add_args)
  489. {
  490.   char buf[64];
  491.   
  492.   sprintf(buf,"0x%x",CAR(args));
  493.   print_string(stacktop,stream,buf);
  494.   
  495.   return CDR(args);
  496. }
  497. EUFUN_CLOSE
  498.  
  499.  
  500. static EUFUN_3(Fn_format_e,stream,args,add_args)
  501. {
  502.   char buf[64],fmtbuf[40];
  503.   double val;
  504.  
  505.   if (is_float(CAR(args)))
  506.     val=CAR(args)->FLOAT.fvalue;
  507.   else if (is_fixnum(CAR(args)))
  508.     val=(double)intval(CAR(args));
  509.   else
  510.     CallError(stacktop,"format: expected a number",CAR(args),NONCONTINUABLE);
  511.  
  512.   if (add_args=nil)
  513.     strcpy(fmtbuf,"%f");
  514.   else if (CDR(add_args)==nil)
  515.     sprintf(fmtbuf,"%%%df",intval(CAR(add_args)));
  516.   else
  517.     sprintf(fmtbuf,"%%%d.%de",intval(CAR(add_args)),intval(CAR(CDR(add_args))));
  518.   
  519.   sprintf(buf,fmtbuf,val);
  520.   print_string(stacktop,stream,buf);
  521.   
  522.   return nil;
  523. }
  524. EUFUN_CLOSE
  525.  
  526. static EUFUN_3(Fn_format_f,stream,args,add_args)
  527. {
  528.   char buf[64],fmtbuf[40];
  529.   double val;
  530.  
  531.   if (is_float(CAR(args)))
  532.     val=CAR(args)->FLOAT.fvalue;
  533.   else if (is_fixnum(CAR(args)))
  534.     val=(double)intval(CAR(args));
  535.   else
  536.     CallError(stacktop,"format: expected a number",CAR(args),NONCONTINUABLE);
  537.  
  538.   if (add_args=nil)
  539.     strcpy(fmtbuf,"%f");
  540.   else if (CDR(add_args)==nil)
  541.     sprintf(fmtbuf,"%%%df",intval(CAR(add_args)));
  542.   else
  543.     sprintf(fmtbuf,"%%%d.%df",intval(CAR(add_args)),intval(CAR(CDR(add_args))));
  544.   
  545.   sprintf(buf,fmtbuf,val);
  546.   print_string(stacktop,stream,buf);
  547.   
  548.   return nil;
  549. }
  550. EUFUN_CLOSE
  551.  
  552. static EUFUN_3(Fn_format_g,stream,args,add_args)
  553. {
  554.   char buf[64],fmtbuf[40];
  555.   double val;
  556.  
  557.   if (is_float(CAR(args)))
  558.     val=CAR(args)->FLOAT.fvalue;
  559.   else if (is_fixnum(CAR(args)))
  560.     val=(double)intval(CAR(args));
  561.   else
  562.     CallError(stacktop,"format: expected a number",CAR(args),NONCONTINUABLE);
  563.  
  564.   if (add_args=nil)
  565.     strcpy(fmtbuf,"%f");
  566.   else if (CDR(add_args)==nil)
  567.     sprintf(fmtbuf,"%%%df",intval(CAR(add_args)));
  568.   else
  569.     sprintf(fmtbuf,"%%%d.%dg",intval(CAR(add_args)),intval(CAR(CDR(add_args))));
  570.   
  571.   sprintf(buf,fmtbuf,val);
  572.   print_string(stacktop,stream,buf);
  573.   
  574.   return nil;
  575. }
  576. EUFUN_CLOSE
  577.  
  578. /* Input operations */
  579.  
  580. EUFUN_1(Fn_read_char,stream)
  581. {
  582.   int c;
  583.  
  584.   c=fgetc(fpof(stream));
  585.   
  586.   if (c==0)
  587.     return q_eof;
  588.   else
  589.     {
  590. #ifdef WITH_FUDGE
  591.       {
  592.     extern void yy_reset_stream(FILE *);
  593.     yy_reset_stream(fpof(stream));
  594.       }
  595. #endif
  596.       return allocate_char(stacktop,c);
  597.     }
  598. }
  599. EUFUN_CLOSE
  600.  
  601. EUFUN_2(Fn_ungetc,stream,c)
  602. {
  603.   ungetc(c->CHAR.code,fpof(stream));
  604.  
  605. #ifdef WITH_FUDGE
  606.       {
  607.     extern void yy_reset_stream(FILE *);
  608.     yy_reset_stream(fpof(stream));
  609.       }
  610. #endif
  611.   
  612.   return lisptrue;
  613. }
  614. EUFUN_CLOSE
  615. /* Read chars until we hit whitespace */
  616. #define READBUFSZ 10
  617. EUFUN_1(Fn_read_line,stream)
  618. {        
  619.   LispObject tmp=nil,oldtmp;
  620.   char buf[READBUFSZ];
  621.   int len=0,i=0,c;
  622.   
  623.   while ((c=getc(fpof(stream)))!=EOF)
  624.     {    
  625.       buf[i]=c;
  626.       i++;
  627.       if (i==READBUFSZ)
  628.     {    /* Grab more... */
  629.       if (tmp==nil)
  630.         {
  631.           tmp=allocate_string(stacktop,buf,READBUFSZ);
  632.         }
  633.       else
  634.         {    
  635.           oldtmp=tmp;
  636.           tmp=allocate_string(stacktop,stringof(oldtmp),len+READBUFSZ);
  637.           strncpy(stringof(tmp)+len,buf,READBUFSZ);
  638.         }
  639.       len+=READBUFSZ;
  640.       i=0;
  641.       stream=ARG_0(stackbase);
  642.     }
  643.  
  644.       if (c=='\n')
  645.     break;
  646.     }    
  647.   
  648.   if (len+i==0)
  649.     return q_eof;
  650.  
  651.   buf[i]='\0';
  652.  
  653.   if (tmp==nil)
  654.     return allocate_string(stacktop,buf,i);
  655.   else
  656.     {
  657.       oldtmp=tmp;
  658.       tmp=allocate_string(stacktop,stringof(oldtmp),len+i);
  659.       strcpy(stringof(tmp)+len,buf);
  660.       return tmp;
  661.     }
  662. }
  663. EUFUN_CLOSE
  664.  
  665. EUFUN_1(Fn_read,stream)
  666. {
  667.   if (stream==nil) 
  668.     return(sys_read(stacktop,stdin));
  669.   else
  670.     return generic_apply_1(stacktop,generic_read,stream);
  671. }
  672. EUFUN_CLOSE
  673.  
  674. EUFUN_1(Fn_fread,stream)
  675. {
  676.  return(sys_read(stacktop,fpof(stream)));
  677. }
  678. EUFUN_CLOSE
  679.  
  680. EUFUN_1(Fn_escape_id_p,s)
  681. {
  682.   extern int escaped_id(char *);
  683.  
  684.   return (escaped_id(stringof(s))
  685.       ? lisptrue : nil);
  686. }
  687. EUFUN_CLOSE
  688.  
  689. #define NSTREAMS_ENTRIES 31
  690.  
  691. MODULE Module_nstreams;
  692. LispObject Module_nstreams_values[NSTREAMS_ENTRIES];
  693.  
  694. void initialise_streams(LispObject *stacktop)
  695. {
  696. #ifdef WITH_FUDGE
  697.   initialise_fudge();
  698. #endif
  699.  
  700.   open_module(stacktop,
  701.           &Module_nstreams,    
  702.           Module_nstreams_values,
  703.           "streams",
  704.           NSTREAMS_ENTRIES);
  705.   
  706.   /* For bootstrapping, we use nil, nil and t for stdin, etc.
  707.      These are re-hacked later */
  708.   MakeStdStreams();
  709.   StdIn()=nil;
  710.   StdOut()=nil;
  711.   StdErr()=lisptrue;
  712.   
  713.   q_eof=allocate_char(stacktop,256);
  714.   add_root(&q_eof);
  715.  
  716.   format_specifiers=allocate_vector(stacktop,256);
  717.   add_root(&format_specifiers);
  718.  
  719.   make_module_entry(stacktop,"*eof*",q_eof);
  720.  
  721.   generic_prin
  722.     = make_module_generic(stacktop,"generic-prin",2);
  723.   add_root(&generic_prin);
  724.  
  725.   generic_write
  726.     = make_module_generic(stacktop,"generic-write",2);
  727.   add_root(&generic_write);
  728.  
  729.   generic_output
  730.     = make_module_generic(stacktop,"output",2);
  731.   add_root(&generic_output);
  732.  
  733.   generic_flush
  734.     = make_module_generic(stacktop,"flush",1);
  735.   add_root(&generic_flush);
  736.  
  737.   generic_read
  738.     = make_module_generic(stacktop,"generic-read",1);
  739.   add_root(&generic_read);
  740.  
  741.   (void) make_module_function(stacktop,"std-streams",Fn_std_streams,0);
  742.   (void) make_module_function(stacktop,"fopen",Fn_fopen,2);
  743.   (void) make_module_function(stacktop,"fpopen",Fn_popen,2);
  744.   (void) make_module_function(stacktop,"freopen",Fn_reopen,1);
  745.   (void) make_module_function(stacktop,"fseek",Fn_seek,2);
  746.   (void) make_module_function(stacktop,"ftell",Fn_tell,1);
  747.   (void) make_module_function(stacktop,"fflush",Fn_flush,1);
  748.   (void) make_module_function(stacktop,"fclose",Fn_close,1);
  749.   (void) make_module_function(stacktop,"fput",Fn_put,2);
  750.  
  751.   (void) make_module_function(stacktop,"print-fixnum",Fn_prin_fixnum,2);
  752.   (void) make_module_function(stacktop,"print-list",Fn_prin_list,2);
  753.   (void) make_module_function(stacktop,"prin-object",Fn_prin_object,2);
  754.  
  755.   (void) make_module_function(stacktop,"std-formatters",Fn_std_formatters,0);
  756.   (void) make_module_function(stacktop,"internal-format",Fn_iformat,3);
  757.   (void) make_module_function(stacktop,"b-formatter",Fn_format_b,3);
  758.   (void) make_module_function(stacktop,"e-formatter",Fn_format_e,3);
  759.   (void) make_module_function(stacktop,"f-formatter",Fn_format_f,3);
  760.   (void) make_module_function(stacktop,"g-formatter",Fn_format_g,3);
  761.   (void) make_module_function(stacktop,"u-formatter",Fn_format_u,3);
  762.  
  763.   (void) make_module_function(stacktop,"read",Fn_read,1);
  764.   (void) make_module_function(stacktop,"fread",Fn_fread,1);
  765.   (void) make_module_function(stacktop,"fread-line",Fn_read_line,1);
  766.   (void) make_module_function(stacktop,"fread-char",Fn_read_char,1);
  767.   (void) make_module_function(stacktop,"fungetc",Fn_ungetc,2);
  768.  
  769.   (void) make_module_function(stacktop,"escaped-id-p",Fn_escape_id_p,1);
  770.   
  771.   close_module();
  772. }
  773.  
  774.